home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Libraries / SAT 2.1.2 / HeartQuest sample ƒ / gameWindow.p < prev    next >
Encoding:
Text File  |  1994-06-02  |  20.3 KB  |  546 lines  |  [TEXT/PJMM]
  1. ch initializes the window and installs}
  2. {handler procedures (note that menus are installed in main.p). It calls the routines}
  3. {to initialize offscreen GrafPorts and all the animated objects. }
  4.  
  5. { When the user selects New Game, StartGame is called to set up a new}
  6. { game, and then MoveIt, the game driver routine is called. }
  7.  
  8. unit GameWind;
  9.  
  10. interface
  11.  
  12.     uses
  13.         transskel, SAT,{Globals, Other, Emergency, OffScreen, Animator, SATSound}
  14.         GameGlobals, sPlayer, sFlypaper, sHeart, sBonus, sPoints, scores, SoundConst, Sound;
  15.  
  16.     procedure DoGameMenu (item: integer);
  17.     procedure GameWindInit;
  18.     procedure DoGameOver;
  19.  
  20.  
  21. implementation
  22.  
  23. {var}
  24. {mp: MonsterPtr; { Bra att ha en global tillgänglig. Dvs praktiskt... }
  25. {    SlemtorksHandlerPtr: ProcPtr;}
  26.  
  27.     procedure InitSprites;
  28.     begin
  29. { Set up the two offscreen GrafPorts "gSAT.offScreen" and "gSAT.backScreen". SAT has a standard}
  30. { way to do this. Let SAT draw the background PICT for us, too. }
  31. {SetupOffAndBack(132, 129);}
  32.  
  33. { Call the init routines for each the sprite unit! Don't forget this! }
  34.         InitFlypaper;
  35.         InitHeart;
  36.         InitPlayer;
  37.         InitBonus;
  38.         InitPoints;
  39.     end;
  40.  
  41.     procedure DrawBackground;
  42.     forward;
  43.  
  44. { Setup a new level. This is called when the game starts ans at each new level.}
  45.     procedure SetupLevel (level: integer);
  46.         var
  47.             p: point;
  48.             i: integer;
  49.             mp, oldmp: SpritePtr;
  50.             r: rect;
  51.             s: Str255;
  52.             er: EventRecord; {For EventAvail}
  53.             strwidth: integer;
  54.  
  55. { A routine to create a bunch of hearts }
  56.         procedure MakeHearts (howmany: integer);
  57.             var
  58.                 i: integer;
  59.                 mp: SpritePtr;
  60.         begin
  61.             for i := 1 to howmany do
  62.                 case rand(4) of
  63.                     0: 
  64.                         mp := NewSprite(-2, Rand(gSAT.offSizeH - 112) + 17, 0, @SetupHeart);
  65.                     1: 
  66.                         mp := NewSprite(-2, Rand(gSAT.offSizeH - 112) + 17, gSAT.offSizeV - 32, @SetupHeart);
  67.                     2: 
  68.                         mp := NewSprite(-2, 0, Rand(gSAT.offSizeV - 32) + 17, @SetupHeart);
  69.                     3: 
  70.                         mp := NewSprite(-2, gSAT.offSizeH - xsize, Rand(gSAT.offSizeV - 32) + 17, @SetupHeart);
  71.                 end;
  72.         end;
  73.  
  74.     begin { SetupLevel }
  75.  
  76. { Clear the sprite list }
  77.         while gSAT.sRoot <> nil do
  78.             KillSprite(gSAT.sRoot);
  79.  
  80. { Create all the sprites for the level, depending on the level number. }
  81.         case level of
  82.             1: 
  83.                 begin
  84.                     batchcount := 6;
  85.                     bonus := 250;
  86.                     MakeHearts(6);
  87.                     mp := NewSprite(-3, 10, 10, @SetupFlypaper);
  88.                     mp := NewSprite(-3, gSAT.offSizeH - xsize - 32, gSAT.offSizeV - 32, @SetupFlypaper);
  89.                 end;
  90.             2: 
  91.                 begin
  92.                     batchcount := 10;
  93.                     bonus := 300;
  94.                     MakeHearts(10);
  95.                     mp := NewSprite(-3, 10, 10, @SetupFlypaper);
  96.                     mp := NewSprite(-3, gSAT.offSizeH - xsize - 32, 20, @SetupFlypaper);
  97.                     mp := NewSprite(-3, 20, gSAT.offSizeV - 32, @SetupFlypaper);
  98.                 end;
  99.             3: 
  100.                 begin
  101.                     batchcount := 12;
  102.                     MakeHearts(12);
  103.                     bonus := 350;
  104.                     mp := NewSprite(-3, 5, 5, @SetupFlypaper);
  105.                     mp := NewSprite(-3, gSAT.offSizeH - xsize - 32, 5, @SetupFlypaper);
  106.                     mp := NewSprite(-3, 5, gSAT.offSizeV - 32, @SetupFlypaper);
  107.                     mp := NewSprite(-3, gSAT.offSizeH - xsize - 32, gSAT.offSizeV - 32, @SetupFlypaper);
  108.                 end;
  109.             4: 
  110.                 begin
  111.                     batchcount := 12;
  112.                     MakeHearts(12);
  113.                     bonus := 350;
  114.                     mp := NewSprite(-3, 5, 5, @SetupFlypaper);
  115.                     mp := NewSprite(-3, gSAT.offSizeH - xsize - 32, 5, @SetupFlypaper);
  116.                     mp := NewSprite(-3, 5, gSAT.offSizeV - 32, @SetupFlypaper);
  117.                     mp := NewSprite(-3, gSAT.offSizeH - xsize - 32, gSAT.offSizeV - 32, @SetupFlypaper);
  118.                     mp := NewSprite(-3, 5, (gSAT.offSizeV - 32) mod 2, @SetupFlypaper);
  119.                     mp := NewSprite(-3, gSAT.offSizeH - xsize - 32, (gSAT.offSizeV - 32) mod 2, @SetupFlypaper);
  120.                 end;
  121.             5: 
  122.                 begin
  123.                     batchcount := 10;
  124.                     MakeHearts(10);
  125.                     bonus := 380;
  126.                     mp := NewSprite(-3, 5, 5, @SetupFlypaper);
  127.                     mp := NewSprite(-3, gSAT.offSizeH - xsize - 32, 5, @SetupFlypaper);
  128.                     mp := NewSprite(-3, 5, gSAT.offSizeV - 32, @SetupFlypaper);
  129.                     mp := NewSprite(-3, gSAT.offSizeH - xsize - 32, gSAT.offSizeV - 32, @SetupFlypaper);
  130.                 end;
  131.             6: 
  132.                 begin
  133.                     batchcount := 12;
  134.                     MakeHearts(12);
  135.                     bonus := 420;
  136.                     mp := NewSprite(-3, 5, 5, @SetupFlypaper);
  137.                     mp := NewSprite(-3, gSAT.offSizeH - xsize - 32, 5, @SetupFlypaper);
  138.                     mp := NewSprite(-3, 5, gSAT.offSizeV - 32, @SetupFlypaper);
  139.                     mp := NewSprite(-3, gSAT.offSizeH - xsize - 32, gSAT.offSizeV - 32, @SetupFlypaper);
  140.                     mp := NewSprite(-3, gSAT.offSizeH - xsize - 32, (gSAT.offSizeV - 32) mod 2, @SetupFlypaper);
  141.                 end;
  142.             otherwise
  143.                 begin
  144.                     batchcount := level * 2;
  145.                     MakeHearts(level * 2);
  146.                     bonus := 300 + 20 * level;
  147.                     for i := 0 to level - 1 do
  148.                         begin
  149.                             case rand(6) of
  150.                                 0: 
  151.                                     mp := NewSprite(-3, 5, 5, @SetupFlypaper);
  152.                                 1: 
  153.                                     mp := NewSprite(-3, gSAT.offSizeH - xsize - 32, 5, @SetupFlypaper);
  154.                                 2: 
  155.                                     mp := NewSprite(-3, 5, 300, @SetupFlypaper);
  156.                                 3: 
  157.                                     mp := NewSprite(-3, gSAT.offSizeH - xsize - 32, gSAT.offSizeV - 32, @SetupFlypaper);
  158.                                 4: 
  159.                                     mp := NewSprite(-3, (gSAT.offSizeH - xsize - 32) div 2, 5, @SetupFlypaper);
  160.                                 5: 
  161.                                     mp := NewSprite(-3, (gSAT.offSizeH - xsize - 32), gSAT.offSizeV - 32, @SetupFlypaper);
  162.                             end; { case }
  163.                         end;
  164.                 end;
  165.         end;
  166. { Reposition mouse to the center of the game area. }
  167.         p.h := 256;
  168.         p.v := 171;
  169.         SetMouse(p);
  170. { Make the player sprite. }
  171.         mp := NewSprite(2, (gSAT.offSizeH - xsize) div 2, gSAT.offSizeV div 2, @SetupPlayer);
  172. { Copy gSAT.backScreen to gSAT.offScreen to erase old sprites. }
  173.         CopyBits(gSAT.backScreen^.portBits, gSAT.offScreen^.portBits, gSAT.offScreen^.portRect, gSAT.offScreen^.portRect, srcCopy, nil);
  174.         PeekOffScreen; {replaces the following out-commented lines:}
  175.  
  176.         AddScore(0);
  177. { Do one frame of animation just to draw all the objects. }
  178.         RunSAT(false); {false or features^^.PlotFast; slow is ok - no hurry!}
  179.  
  180.         if level = 1 then
  181.             strwidth := StringWidth(MyGetIndString(startgameStrID))
  182.         else
  183.             strwidth := StringWidth(MyGetIndString(startlevelStrID));
  184.  
  185. { Draw a message and wait for click- this is a bit ugly. Consider other ways. }
  186.         SetPort(gSAT.wind);
  187.         SetRect(r, gSAT.offSizeH div 2 - strwidth div 2 - 5 + 2, gSAT.offSizeV div 2 + 35 + 2, gSAT.offSizeH div 2 + strwidth div 2 + 5 + 2, gSAT.offSizeV div 2 + 60 + 2); {offset by 2 pixels}
  188.         PaintRect(r);
  189.         SetRect(r, gSAT.offSizeH div 2 - strwidth div 2 - 5, gSAT.offSizeV div 2 + 35, gSAT.offSizeH div 2 + strwidth div 2 + 5, gSAT.offSizeV div 2 + 60);
  190.         EraseRect(r);
  191.  
  192.         MoveTo(gSAT.offSizeH div 2 - strwidth div 2, gSAT.offSizeV div 2 + 50);
  193.         if level = 1 then
  194.             DrawString(MyGetIndString(startgameStrID)) {str 16: Click the mouse to start the game.}
  195.         else
  196.             begin
  197.                 DrawString(MyGetIndString(startlevelStrID)); {str 17: Click the mouse to start level }
  198.                 NumToString(level, s);
  199.                 DrawString(s);
  200.                 DrawChar('.');
  201.             end;
  202.  
  203. {Wait until something happens}
  204.         FlushEvents(EveryEvent, 0); { To forget events, like mouse clicks etc. }
  205.         repeat
  206.         until EventAvail(mDownMask + keyDownMask, er);
  207.  
  208. { Redraw to get rid of the message we just made. }
  209.         PeekOffScreen;
  210.     end; { SetupLevel }
  211.  
  212. { Start a new game. Initialize level, score, number of lives, and call setuplevel to make the first level. }
  213.     procedure StartGame;
  214.     begin
  215.         ZeroScore;
  216.         Level := 1;
  217.  
  218.         setuplevel(level);
  219.     end;
  220.  
  221. { Game Over procedure. Draw "Game Over" text, check high scores. }
  222.  
  223.     procedure DoGameOver;
  224.         var
  225. { Variables for the Game Over-box }
  226.             theRect, theRect2: rect;
  227.             thePict: Handle;
  228.             bredd, i: integer;
  229.             dx, dy: integer;
  230.             time: longint;
  231.     begin
  232.         SetItem(GameMenu, Pause, MyGetIndString(pauseStrID)); {str 18: Pause}
  233. { Game Over display! }
  234.         SetPort(gSAT.wind);
  235.         if colorFlag and (gSAT.initDepth <> 1) then
  236.             thePICT := GetResource('PICT', 129)
  237.         else
  238.             thePICT := GetResource('PICT', 128);
  239.         theRect := PicHandle(thePICT)^^.picFrame;
  240.         theRect.right := theRect.right - theRect.left;
  241.         theRect.bottom := theRect.bottom - theRect.top;
  242.         theRect.top := 0;
  243.         theRect.left := 0;
  244.  
  245.         dx := (gSAT.offSizeH - (theRect.right - theRect.left)) div 2 - theRect.left;
  246.         dy := (gSAT.offSizeV - (theRect.bottom - theRect.top)) div 2 - theRect.top;
  247.         OffsetRect(theRect, dx, dy);
  248.  
  249.         bredd := theRect.right - theRect.left;
  250.         theRect2 := theRect;
  251.  
  252.         i := 1;
  253.         repeat
  254.             time := TickCount;
  255.             theRect.right := theRect2.right - bredd * (80 - i) div 160;
  256.             theRect.left := theRect2.left + bredd * (80 - i) div 160;
  257.             DrawPicture(PicHandle(thePICT), TheRect);
  258.             i := i + TickCount - time;
  259.         until i >= 80;
  260.  
  261.         SetPort(gSAT.offScreen);
  262.         DrawPicture(PicHandle(thePICT), TheRect);
  263.         SetPort(gSAT.wind);
  264.  
  265.         InvalRect(theRect);
  266.  
  267.         SATSoundShutUp; { Dispose of sound channel }
  268.  
  269.         FlushEvents(everyEvent, 0); { To forget events, like mouse clicks etc. }
  270.         ShowCursor;
  271.  
  272.         UpdateHigh; { Game over, was it high score? }
  273.     end;
  274.  
  275.  
  276. { This routine is the game driver. It calls the "Animator" package until the game ends or is paused. }
  277. { I also read the keyboard here. This could optionally be moved to the "player object" module. }
  278.  
  279.     procedure MoveIt;
  280.         var
  281.             fr, tr, r: Rect;
  282.             pt: Point;
  283.             h: Integer;
  284.             truepos: Longint;
  285. {n, x: Integer;    { Are these used? }
  286.             t, l: longint;
  287.             truepos32, bredd32: integer; { Some old bugfix that I no longer remember... }
  288.             truepos19, bredd19: integer;
  289.             theEvent: EventRecord; { för att testa musklick }
  290. { To check for key clicks with GetKeys:  - no longer used. km: KeyMap;}
  291.             hasEvent: Boolean;
  292.             ignore: OSerr;
  293.     begin
  294.         stillrunning := true; { A flag that tells whether or not to quit this routine. }
  295.  
  296.         HideCursor; { NOTE: No matter how we leave the MoveIt procedure, we should ShowCursor. }
  297.  
  298.         pt.h := 256;
  299.         pt.v := 171;
  300.         SetMouse(pt);
  301.  
  302. { Main loop! Keep running until the game is paused or ends. }
  303.         while stillrunning = true do
  304.             begin
  305.                 t := TickCount;
  306.                 SetPort(gSAT.wind);
  307.                 SetPort(gSAT.offScreen);
  308.  
  309. { Here is the real heart of the loop: call Animator once per loop. It will call all the objects. }
  310.                 RunSAT(features^^.plotFast);
  311. {SATSoundEvents; No longer needed - included in RunSAT!}
  312.  
  313. { All the rest of the main loop is game specific, next level, bonus handling, etc. }
  314.                 if (batchcount < 1) then
  315.                     begin
  316.                         SATSoundShutUp;
  317.                         if false then
  318.                             if features^^.sound then
  319.                                 ignore := SndPlay(nil, GetResource('snd ', SadarSnd), false);
  320.  
  321.                         SATSoundPlay(SadarSndH, 0, true);
  322.                         repeat
  323.                             SATSoundEvents
  324.                         until SATSoundDone;
  325.  
  326.                         if bonus > 0 then
  327.                             while bonus > 0 do
  328.                                 begin
  329.                                     Bonus := Bonus - 10;
  330. { SndPlay would have been ok here, since we want to play this synchronously.}
  331.  
  332.                                     SATSoundPlay(KlounkSndH, 0, true);
  333.                                     repeat
  334.                                         SATSoundEvents
  335.                                     until SATSoundDone;
  336.  
  337.                                     if false then
  338.                                         if features^^.sound then
  339.                                             ignore := SndPlay(nil, GetResource('snd ', KlounkSnd), false);
  340.  
  341.                                     if bonus < 0 then
  342.                                         begin
  343.                                             l := bonus;
  344.                                             bonus := 0;
  345.                                             AddScoreS(10 + l); {A special synchronous version of AddScore}
  346.                                         end
  347.                                     else
  348.                                         AddScoreS(10); { Bonus! }
  349.                                 end { if bonus > 0 }
  350.                         else if features^^.macho then
  351.                             stillrunning := false; { If no bonus, game over }
  352.  
  353.                         if (stillrunning and features^^.macho) or (level < 3) then {level < 4}
  354.                             begin
  355.                                 level := level + 1;
  356.                                 SetupLevel(level);
  357.                                 AddScoreS(0); {To update the level number}
  358.                             end
  359.                         else
  360.                             stillrunning := false;
  361.                     end; {if (batchcount < 1)}
  362.  
  363. { Check for keys being pressed }
  364.                 if features^^.allowBG then { if we are allowed to use the normal method }
  365.                     begin
  366.                         SystemTask;
  367. { Replaced the following call by WaitNextEvent if you want to be modern (but less backwards compatible). :-) }
  368.                         hasEvent := GetNextEvent(keyDownMask, theEvent)
  369.                     end
  370.                 else {Otherwise, use the faster GetOSEvent}
  371.                     begin
  372.                         hasEvent := GetOSEvent(keyDownMask, theEvent)
  373.                     end;
  374.  
  375. {If there was a keydown, see if it was one of the menu options that we support when running.}
  376.                 if hasEvent then { there was a keydown }
  377.                     if BitAnd(theEvent.modifiers, cmdKey) <> 0 then
  378.                         begin
  379.                             case char(BitAnd(theEvent.message, charCodeMask)) of
  380.                                 'p': 
  381.                                     begin
  382.                                         PauseFlag := true;
  383.                                         SATSoundShutUp; { Dispose of sound channel }
  384.                                         ShowCursor;
  385.                                         flushevents(6 + 8, 0); { In order to forget the cmd-p }
  386.                                         SetItem(GameMenu, Pause, MyGetIndString(resumeStrID)); {str 19: Resume}
  387.                                         exit(MoveIt);
  388.                                     end;
  389.                                 '.': 
  390.                                     StillRunning := false;
  391.                                 'q': 
  392.                                     begin
  393.                                         StillRunning := false;
  394.                                         SkelWhoa;
  395.                                     end;
  396.                                 's': 
  397.                                     begin
  398.                                         DoGameMenu(sound);
  399.                                     end;
  400.                                 otherwise
  401.                                     ;
  402.                             end; {case}
  403.                         end;
  404.  
  405. { Delay, using TickCount so it doesn't matter how fast our Mac is. }
  406.                 while ((TickCount - t) < 3) do
  407.                     ;
  408.  
  409.             end; { while stillrunning (main loop) }
  410.  
  411.         DoGameOver;
  412.  
  413.         FlushEvents(mouseDown + keyDown, 0); { In order to forget the cmd-p }
  414.     end;
  415.  
  416.  
  417. {We draw the background ourselves rather than using a simple backdrop PICT, to save space and to get the}
  418. {dithered background.}
  419.     procedure DrawBackground;
  420.         var
  421.             ph: PicHandle;
  422.             ignore: OSErr;
  423.             ramp: CTabHandle;
  424.             extraOff: CGrafPtr;
  425.             extraOffGD: GDHandle;
  426.             col: RGBColor;
  427.             thinr, r: Rect;
  428.             i, j: integer;
  429.  
  430.             posH, posV, scale, height, width: longint; {For scaling the trees}
  431.     begin
  432.         SATSetPortBackScreen;
  433.         SetRect(r, 0, 0, gSAT.offSizeH, gSAT.offSizeV);
  434.         if colorFlag then
  435.             begin
  436. {Draw our PICT under it.}
  437.                 if gSAT.initDepth = 1 then
  438.                     ph := GetPicture(133)
  439.                 else
  440.                     ph := GetPicture(132); {color PICT}
  441.                 if ph = nil then
  442.                     ReportStr(MyGetIndString(nopictStrID)); {STR 20: Can''t get PICT.}
  443.                 if ph <> nil then
  444.                     begin
  445.                         DrawPicture(ph, r);
  446.                         ReleaseResource(handle(ph));
  447.                     end;
  448. {Set up an 8 bit offscreen with a special color table, and ditherCopy to gSAT.backScreen.}
  449.                 ramp := GetCTable(128);
  450.                 if ramp = nil then
  451.                     ReportStr(MyGetIndString(noclutStrID)); {str 21. Can''t get CLUT 128.}
  452.                 if ramp <> nil then
  453.                     begin
  454.                         SetRect(thinr, 0, 0, 5, gSAT.offSizeV);
  455.                         ignore := CreateOffScreen(thinr, 8, ramp, extraOff, extraOffGD);
  456.                         if ignore <> noErr then
  457.                             ReportStr(MyGetIndString(nooffscreenStrID)); {str 22: Can''t make offscreen.}
  458.                         SetPort(GrafPtr(extraOff));
  459.                         SetGDevice(extraOffGD);
  460.                         PaintRect(extraOff^.portRect);
  461. {Make a scale of shades}
  462.                         for i := 0 to gSAT.offSizeV do
  463.                             begin
  464. {$PUSH}
  465. {$V-}
  466.                                 col.green := BSL(i, 16) div gSAT.offSizeV;
  467. {$POP}
  468.                                 col.red := col.green;
  469.                                 col.blue := col.green;
  470.                                 RGBForeColor(col);
  471.                                 MoveTo(0, i);
  472.                                 LineTo(5, i); {gSAT.offSizeH}
  473.                             end;
  474.  
  475.                         col.red := 0;
  476.                         col.green := 0;
  477.                         col.blue := 0;
  478.                         RGBForeColor(col);
  479.  
  480.                         r.top := gSAT.offSizeV div 4;
  481.                         thinr.top := gSAT.offSizeV div 4;
  482.  
  483.                         SATSetPortBackScreen;
  484.                         CopyBits(GrafPtr(extraOff)^.portBits, gSAT.backScreen^.portBits, thinr, r, srcCopy + ditherCopy, nil);
  485.                         DisposeOffscreen(extraOff, extraOffGD);
  486.  
  487.                     end;
  488.  
  489.             end
  490.         else
  491.             begin {This could just as well have been done by SAT}
  492.                 ph := GetPicture(133); {bw PICT}
  493.                 SATSetPortBackScreen;
  494.                 if ph <> nil then
  495.                     begin
  496.                         DrawPicture(ph, r);
  497.                         ReleaseResource(handle(ph));
  498.                     end;
  499.             end;
  500.  
  501. {Draw trees using PICTs!}
  502.  
  503. {First get the right PICT}
  504.         if gSAT.initDepth = 1 then
  505.             begin
  506.                 ph := GetPicture(135); {bw tree PICT}
  507.             end
  508.         else
  509.             begin
  510.                 ph := GetPicture(134); {color tree PICT}
  511.             end;
  512.  
  513. {Scale by ph^^.picframe}
  514.         for i := 0 to 10 do
  515. {For more trees: for j := i to 4 do}
  516.             begin
  517.                 posH := Rand(gSAT.offSizeH);
  518.                 posV := gSAT.offSizeV div 2 + longint(i) * i * gSAT.offSizeV div 300;
  519.  
  520.                 scale := (posV - gSAT.offSizeV div 4) div 17;
  521.                 height := scale * (ph^^.picframe.bottom - ph^^.picframe.top) div 40;
  522.                 width := scale * (ph^^.picframe.right - ph^^.picframe.left) div 40;
  523.  
  524.                 r.top := posV - height;
  525.                 r.bottom := posV;
  526.                 r.right := posH + width;
  527.                 r.left := posH;
  528.  
  529.                 DrawPicture(ph, r);
  530.             end;
  531.  
  532.         ReleaseResource(handle(ph));
  533.  
  534.         CopyBits(gSAT.backScreen^.portBits, gSAT.offScreen^.portBits, gSAT.backScreen^.portRect, gSAT.backScreen^.PortRect, srcCopy + ditherCopy, nil);
  535.         SATSetPortScreen;
  536.     end;
  537.  
  538.  
  539.     procedure GameWindUpdate;
  540.         var
  541.             s: str255;
  542.             r: Rect;
  543.             crsr: CursHandle;
  544.     begin
  545. {When the depth has changed, the game wind will get an update event,}
  546. {so let's